package gri2_requests;

use DBI;
use Data::Dumper;
use File::Basename;
use MIME::Base64;
use gri_portal_config;

############################################################################
# Request fields are as follows....
# id   - Unique request ID
# type - PAR  - Portal access Request
#        PARR - Portal access revocation Request
# raised - utime - UNIX time of when request raised
# user - User id requesting the change
# object - the name of the obect for the access change (portal name usually)
#          base64 encoded.
# req_comments - Requestors original comments - base64 encoded.
# owners_votes - uid|utime|Ycomments or uid|utime|Ncomments ... each item '|' separated. Comments 
#                are base64 encoded.
# voters_votes - same format as above, but for voters, not owners.
# decision     - A/D (approve/deny) - if entry here record is closed...
# concurrence  - number of user or % of voters that must allow access
# informed     - (Y|N) utime - Has used been informed
# comments     - General comments - base64 encoded.
#				 Format is "UID|utime|base64_comments|..."
#
# If a portal does not have voters, but does have owners then
# the owners get an email -any one of which can grant access. However 
# should alsoprovide them with a deny link giving them a page to type some
# details in and then inform the user of why denied.
#
# In such situations the recommendation is to stuff a record in the
# requests database to allow the user to have it tracked. In such situations
# the record format will appear similar to the following:
#
# id   - Unique request ID
# type - PAR  - Portal access Request
#        PARR - Portal access revocation Request
# raised - utime - UNIX time of when request raised
# user - User id requesting the change
# object - the name of the obect for the access change (portal name usually)
#          base64 encoded.
# req_comments - Requestors original comments - base64 encoded.
# owners_votes - uid|utime|Y or N|utime|comments
#				 Only one entry when no voters since any owner can make
#                decision. Comments are base64 encoded.
# voters_votes - N/A - set to this value to indicate no voters.
# decision     - A/D (approve/deny) - also from the information in the 
#                owners_votes field.
# concurrence  - N/A
# informed     - (Y|N) utime - Has used been informed via email.
# comments     - General comments - base64 encoded.
#  
############################################################################

# Decision making process (for portals for example)
# Any owner can instantly pass/fail access - take precedence over voters.
# Voters go towards the concurance count
# If decision is made then field set and user informed, and information
# added to comments.
#

my $cldb_errcode=0;
my $cldb_errstr=undef;

sub _exists($$$) {
my $self=shift;
my ($type,$obj)=@_;
my ($cmd,$rc,$sth);

	$cldb_errcode=0;
	$cldb_errstr=undef;
	$type="table" if !defined($type);
	$cmd="SELECT * FROM SQLITE_MASTER WHERE type = '$type' AND name = '$obj';";
	my $h=$self->{dbh}->selectrow_hashref($cmd);
	if(!defined($h)) {
		return 0;
	}
	return 1;
}

sub qs($$) {
my $self=shift;
my $s=shift;

	return $self->{dbh}->quote($s);
}

sub get_dbh($) {
	return $_[0]->{dbh};
}

sub do($$;$) {
my $self=shift;
my $timeout=$_[2];

	$timeout=5 if !defined($timeout);
	$cldb_errcode=0;
	$cldb_errstr=undef;
	my $ctime=0;
	while($ctime<=$timeout) {
		$self->{dbh}->do($_[0]);
		if(defined($self->{dbh}->err) && $self->{dbh}->err==5) {
			$cldb_errcode=5;
			$cldb_errstr=$self->{dbh}->errstr;
			# locked error;
			$ctime+=0.10;
			select(undef,undef,undef,0.10);
			next;
		}
		my $rc=$self->{dbh}->errstr;
		if(defined($rc)) {
			$cldb_errcode=2;
			$cldb_errstr=$rc;
			return 0;
		}
		return 1;
	}
	return 0;
}

sub get_rows($$) {
my ($self,$query)=@_;
my ($sth,$rc,@R,$aref);

	$cldb_errcode=0;
	$cldb_errstr=undef;
	$sth=$self->{dbh}->prepare($query);
	if(!defined($sth)) {
		$rc=$self->{dbh}->errstr;
		$cldb_errcode=5;
		$cldb_errstr=$rc;
		return undef;
	}
	$sth->execute();
	@R=();
	while($aref  = $sth->fetchrow_hashref) {
		push @R,{%$aref};
	}
	return \@R;
}

sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self  = {};
my $dbname=$_[0];

	$cldb_errcode=0;
	$cldb_errstr=undef;
	$self->{dbname}=$dbname;
	my $dir=dirname($dbname);
	if(! -w $dir) {
		print STDERR "ERROR: The directory '$dir' is not writable by UID '$<'.\n";
		$cldb_errcode=1;
		$cldb_errstr="The directory '$dir' is not writable by UID '$<'.\n";
		return undef;

	}
	$self->{dbh}=DBI->connect("dbi:SQLite:dbname=$dbname","","",
		{RaiseError => 0,PrintError => 0,AutoCommit => 1});

	bless($self,$class);

	# Create the doc_index table if necessary
	if(! _exists($self,"table","requests")) {
		my $r=$self->do("CREATE TABLE requests(
			id   CHAR(30),
			type CHAR(10),
            user CHAR(30),
            raised INTEGER,
            object CHAR(200),
            req_comments CHAR(1000),
            owners_votes CHAR(1000),
            voters_votes CHAR(1000),
            decision CHAR(10),
            concurrence CHAR(10),
            informed CHAR(1),
            comments CHAR(1000) );");

		if(!$r) {
			$self->{dbh}=DBI->connect("dbi:SQLite2:dbname=$dbname","","",
				{RaiseError => 0,PrintError => 0,AutoCommit => 1});

			if(! _exists($self,"table","requests")) {
				my $r=$self->do("CREATE TABLE requests(
					id   CHAR(30),
					type CHAR(10),
					user CHAR(30),
					raised INTEGER,
					object CHAR(200),
					req_comments CHAR(1000),
					owners_votes CHAR(1000),
					voters_votes CHAR(1000),
					decision CHAR(1),
					concurrence CHAR(10),
					informed CHAR(1),
					comments CHAR(1000) );");
				if(!$r) {
					$cldb_errcode=1;
					$cldb_errstr="Failed to create the 'requests' table.";
					return undef;
				}
			}
		}
	}
	bless($self,$class);
	return $self;
}

sub error {
	return($cldb_errcode,$cldb_errstr);
}


sub _contains_field($$$) {
my ($dbh,$obj,$field)=@_;
my ($cmd,$rc,$sth);

	$cmd="SELECT sql FROM SQLITE_MASTER WHERE type = 'table' AND name = '$obj';";
	my $h=$dbh->selectrow_hashref("$cmd");
	if(!defined($h)) {
		return -1; # table does not exist
	}
	return $self;
}

sub req2_error {
	return($cldb_errcode,$cldb_errstr);
}


sub req2_contains_field($$$) {
my ($dbh,$obj,$field)=@_;
my ($cmd,$rc,$sth);

	$cmd="SELECT sql FROM SQLITE_MASTER WHERE type = 'table' AND name = '$obj';";
	my $h=$dbh->selectrow_hashref("$cmd");
	if(!defined($h)) {
		return -1; # table does not exist
	}
	my @F;
	if ($h->{sql} =~ /\n/) {
		@F=split(/\n/,$h->{sql});
	} else {
		my $xx=$h->{sql};
		$xx =~ s/^CREATE TABLE $obj\(//;
		$xx =~ s/\)$//;
		@F=("junk",split(/,/,$xx),"junk");
	}
	for my $cl (@F[1 .. $#F-1]) {
		my $y=$cl;
		$y =~ s/^\s+//;
		my @F2=split(/\s+/,$y);
		if(lc($F2[0]) eq lc($field)) {
			return 1; # field already exists
		}
	}
	return 0; # field does not exist
}

sub _table_field_list($$) {
my ($dbh,$table)=@_;
my ($cmd,$rc,$sth);

	$cmd="SELECT sql FROM SQLITE_MASTER WHERE type = 'table' AND name = '$table';";
	my $h=$dbh->selectrow_hashref("$cmd");
	if(!defined($h)) {
		return (0,[],[]); # table does not exist
	}
	my @F;
	if ($h->{sql} =~ /\n/) {
		@F=split(/\n/,$h->{sql});
	} else {
		my $xx=$h->{sql};
		$xx =~ s/^CREATE TABLE $table\(//;
		$xx =~ s/\)$//;
		@F=("junk",split(/,/,$xx),"junk");
	}
	my @FF=();
	my @FF2=();
	for my $cl (@F[1 .. $#F-1]) {
		my $y=$cl;
		$y =~ s/^\s+//;
		$y =~ s/,$//;
		my @YY=split(/\s+/,$y);
		push @FF,$YY[0];
		push @FF2,$YY[1];
	}
	return(1,[@FF],[@FF2]);
}

sub _get_rows($$) {
my ($dbh,$query)=@_;
my ($sth,$rc,@R,$aref);

	$sth=$dbh->prepare($query);
	if(!defined($sth)) {
		$rc=$dbh->errstr;
		return undef;
	}
	$sth->execute();
	@R=();
	while($aref  = $sth->fetchrow_hashref) {
		push @R,{%$aref};
	}
	return \@R;
}

# Returns:								#
# -1 = specified table does not exist.					#
# -2 = unable to get field definitions for table.			#
# 1  = field already present; no work required.				#
# 10+ - field added, r-10 records updated.				#

sub _add_field($$$$$) {
my ($dbh,$table,$field,$type,$value)=@_;

	my $z=_contains_field($dbh,$table,$field);
	if($z!=0) {
		return $z;
	}
	# Get the table defintiion information..

	my ($x,$r1,$r2)=_table_field_list($dbh,$table);
	if($x==0) {
		return -2;
	}
	my $cmd="create table ${table}_backup(\n";
	my $cmd2="create table ${table}(\n";
	my $ii=0;
	while($ii<@$r1) {
		$r2->[$ii]="" if !defined($r2->[$ii]);
		$cmd2.="  $r1->[$ii] $r2->[$ii],\n";
		if($ii+1==@$r1) {
			$cmd.="  $r1->[$ii] $r2->[$ii]\n";
		} else {
			$cmd.="  $r1->[$ii] $r2->[$ii],\n";
		}
		$ii++;
	}
	$cmd.=");";
	$cmd2.="  $field $type\n);";

	$dbh->do($cmd);
	$cmd="insert into ${table}_backup SELECT " . join(",",@$r1) . " FROM $table;";
	$dbh->do($cmd);
	$cmd="DROP TABLE $table;";
	$dbh->do($cmd);
	$dbh->do($cmd2);
	# Read recrods from backup to new...
	$cmd="select * from ${table}_backup;";
	my @FLIST=(@$r1,$field);
	my $flist_txt=join(",",@FLIST);
	my $rr=_get_rows($dbh,$cmd);
	my $count=0;
	for my $crec (@$rr) {
		$crec->{$field}=$value;
		$cmd="INSERT INTO $table ($flist_txt) VALUES (";
		my $cc="";
		for my $xxx (@FLIST) {
			$cc.=",'$crec->{$xxx}'";
		}
		$cmd.=substr($cc,1) . ");";
		$dbh->do($cmd);
		$count++;
	}
	$cmd="DROP TABLE ${table}_backup;";
	$dbh->do($cmd);
	return 10+$count;
}

sub _generate_request_id {
my $t=time; my $t2=rand();

	$t2 =~ s/\.//;
	return "$t$t2";
}

# If the specified portal has no voters, but has an owner then
# still raise a request with the specified content as shown in
# the text at the top of the page.

sub register_portal_access_request($$) {
my $self=shift;
my $ref=shift;

	for my $cf ('user','portal','text','frontend') {
		if(!exists($ref->{$cf})) {
			return {
				id => $m->[0]->{id},
				error => "Missing mandatory argument '$cf'.",
				notes => undef,
			};
		}
	}
	my $user=$ref->{user};
	my $portal=$ref->{portal};
	my $txt=$ref->{text};
	my $gri_frontend=$ref->{frontend};

	my $id=_generate_request_id();
	$txt=encode_base64($txt,"");
	my $rr=$gri_frontend->get_portal_details($portal);
	my $portal2=encode_base64($portal,"");
	if(defined($rr->{error})) {
		return {
			id => undef,
			notes => undef,
			error => $rr->{error}
		};
	}

	# Check to see if the request has already been raised then
	# return that ID and a message indicating the request is
	# in process.


	my $m=get_rows($self,"select * from requests where type = 'PAR' and user = '$user' and object = '$portal2' and decision = '';");
	if(@$m) {
		return {
			id => $m->[0]->{id},
			error => undef,
			notes => undef,
		};
	}

	# We should have enough details to construct the record now...

	my $voters="";
	my $owners="";
	for my $c (@{$rr->{owners}}) {
		$owners.="$c||".encode_base64("==NO_COMMENTS==","").' ';
	}
	my $comments=encode_base64("==NO_COMMENTS==","");
	my $concur_count;
	if(@{$rr->{voters}}) {
		for my $c (@{$rr->{voters}}) {
			$voters.="$c||".encode_base64("==NO_COMMENTS==","").' ';
		}
		$concur_count=$rr->{concur_count};
	} else {
		$voters="N/A";
		$concur_count="N/A";
	}
	my $ut=time();
	my $sql="INSERT INTO requests (id,raised,type,user,object,req_comments,owners_votes,voters_votes,decision,concurrence,informed,comments) VALUES('$id','$ut','PAR','$user','$portal2','$txt','$owners','$voters','','$concur_count','','$comments');";
	my $r=$self->do($sql);
	if(!$r) {
		return {
			id => undef,
			notes => undef,
			error => "Failed to load record in DB.",
		};
	}

	return {
		id => $id,
		notes => undef,
		error => undef,
	};
}
#
# The ref fields available are:
# user
# [maxclosed] - maximum closed records to include
# [maxage]    - maximum age of any records to send
#
# Returns {error=>undef,count=N,records=[{}]}

sub get_my_requests($$) {
my $self=shift;
my $ref=shift;

	if(!exists($ref->{user})) {
		return {
			error=>"Missing mandatory 'user' field.",
			count=>-1,
			records=>[],
		};
	}
	if($ref->{user} =~ /[\s\'\"]$/) {
		return {
			id => undef,
			error => "Invalid user specified.",
			notes => undef,
		};
	}
	my $maxclosed=5;
	my $maxage=90;

	if(exists($ref->{maxage}) && defined($ref->{maxage})) {
		$maxage=$ref->{maxage};
	}
	if(exists($ref->{maxclosed}) && defined($ref->{maxclosed})) {
		$maxclosed=$ref->{maxclosed};
	}

	my $t_maxage=time - 86400*$maxage;
	my $sql="SELECT * FROM requests WHERE user = '$ref->{user}' AND decision = '' AND raised > $t_maxage ORDER BY raised;";
	my $sql2="SELECT * FROM requests WHERE user = '$ref->{user}' AND informed LIKE 'Y%' ORDER BY informed DESC LIMIT $maxclosed;";
	my $sql3="SELECT * FROM requests WHERE user = '$ref->{user}' AND decision LIKE 'CA %' ORDER BY informed DESC LIMIT $maxclosed;";
	my $m=get_rows($self,$sql); $m=[] if !defined($m);
	my $m2=get_rows($self,$sql2); $m2=[] if !defined($m2);
	my $m3=get_rows($self,$sql3); $m3=[] if !defined($m3);

	my $cc=scalar(@$m)+scalar(@$m2)+scalar(@m3);
	return {
		error => undef,
		count => $cc,
		records => [@$m,@$m2,@$m3],
	};
}

# This takes a request for access to a portal and changes it to a complete/deny
# request. It does this by making the following alterations to the record in
# question:
# Decision: D - if owner
# informed: Y utime - if enough decisions have been made or is owner/portal_admin
# owners_votes/voters_votes updated if the who_by is an owner/voter with
# any comments they provided. If not owner/voter add the comments to the 
# the owner (probably a user with portal_admin access overall).
# 
# It does not send an email - this is assumed to occur by code calling
# this separately.

sub deny_portal_access_request($$) {
my $self=shift;
my $ref=shift;

	for my $cf ('user','portal','text','frontend','who_by') {
		if(!exists($ref->{$cf})) {
			return {
				id => undef,
				error => "Missing mandatory argument '$cf'.",
				notes => undef,
			};
		}
	}
	my $user=$ref->{user};
	my $portal=$ref->{portal};
	my $txt=$ref->{text};
	my $gri_frontend=$ref->{frontend};
	my $who_by=$ref->{who_by};

	my $rr=$gri_frontend->get_portal_details($portal);
	my $is_owner=0;
	my $is_voter=0;
	my $is_admin=0;
	if(grep {$_ eq $who_by} @{$rr->{owners}}) {
		$is_owner=1;
	}
	if(grep {$_ eq $who_by} @{$rr->{voters}}) {
		$is_voter=1;
	}
	if($is_owner==0 && $is_voter==0) {
		my ($role,$err);
		($role,$err)=$gri_frontend->does_user_have_role($who_by,"portal_admin");
		if(!defined($role)) {
			return {
				id => undef,
				notes => undef,
				error => "Failed to get user role details for $who_by: $err",
			};
		}
		if($role==0) {
			return {
				id => undef,
				notes => undef,
				error => "The user $who_by does not have permissions to vote or grant access for the portal '$portal'.",
			};
		}
		$is_admin=1;
	}
	my $portal2=encode_base64($portal,"");
	if(defined($rr->{error})) {
		return {
			id => undef,
			notes => undef,
			error => $rr->{error}
		};
	}

	# Check to see if the request has already been raised then
	# return that ID and a message indicating the request is
	# in process.
	my $m=get_rows($self,"select * from requests where type = 'PAR' and user = '$user' and object = '$portal2' and decision = '' ORDER BY raised;");
	if(! @$m) {
		return {
			id => "not_found",
			error => undef,
			notes => undef,
		};
	}
	# Delete all apart from the last (previous = older duplicates)
	for(my $ii=1;$ii<scalar(@$m); $i++) {
		my $rc=$self->do("DELETE FROM requests where id = '$m->[$ii]->{id}';",10);
	}

	# if (for whatever reason) there are multiple requests uncompete we
	# mark all as complete to save showing up again...
	my $ctime=time;
	my $enc=encode_base64($txt,"").' ';
	my $crec=$m->[0];
	B2: {
		# We should have enough details to construct the record now...

		$crec->{owners_votes}='' if !defined($crec->{owners_votes});
		$crec->{voters_votes}='' if !defined($crec->{voters_votes});
		if($is_owner || $is_admin) {
			my @D=split($crec->{owners_votes});
			push @D,"$who_by|$ctime|N$enc";
			$crec->{owners_votes}=join(' ',@D);
			$crec->{decision}='D';
			$crec->{informed}="Y $ctime";

			# Write out the changed record...
			my $sql="UPDATE requests SET owners_votes='$crec->{owners_votes}', decision='$crec->{decision}', informed='$crec->{informed}' WHERE id = '$crec->{id}';";
			my $rc=$self->do($sql,10);
			return {
				allow => 0,
				id => $crec->{id},
				notes => "The request has been changed to a closed:deny status.",
				error => undef,
			};
		} else {
			# Not an owner, so register vote and comments.
			my @D=split(/\s+/,$crec->{voters_votes});
			push @D,"$who_by|$ctime|N$enc";
			$crec->{voters_votes}=join(' ',@D);
			# Count OK votes now.
			my %u=();
			for my $dd (@D) {
				next if !$dd;
				my @f=split(/\|/,$dd);
				$u{$f[0]}=substr($f[2],0,1);
			}
			my $allow_count=0;
			my $deny_count=0;
			for my $ck (keys %u) {
				$allow_count++ if $u{$ck} eq 'Y';
				$deny_count++ if $u{$ck} eq 'N';
			}
			my $vc=scalar(@{$rr->{voters}});
			my $pass_percent=$allow_count/$vc*100.0;
			my $fail_percent=$deny_count/$vc*100.0;
			$allow=undef;
			if($crec->{concurrence} =~ /\%$/) {
				if($pass_percent >= int($crec->{concurrence})) {
					$allow=1;
				} elsif($fail_percent > (100 - int($crec->{concurrence}))) {
					$allow=0;
				}
			} else {
				if($allow_count >= $crec->{concurrence}) {
					$allow=1;
				} elsif($deny_count > ($v - $crec->{concurrence})) {
					$allow=0;
				}
			}
			# If allow==1 can allow access, allow==0 deny access, allow=undef more votes needed!!
			if(!defined($allow)) {
				my $sql="UPDATE requests SET voters_votes='$crec->{voters_votes}' WHERE id = '$crec->{id}';";
				my $rc=$self->do($sql,10);
				return {
					allow => -1,
					id => $crec->{id},
					notes => "Your vote has been registered for request.",
					error => undef,
				};
			} elsif($allow==1) {
				$crec->{decision}="A $ctime";
				$crec->{informed}="Y $ctime";
			} elsif($allow==0) {
				$crec->{decision}="D $ctime";
				$crec->{informed}="Y $ctime";
			}
			my $sql="UPDATE requests SET voters_votes='$crec->{voters_votes}', decision='$crec->{decision}', informed='$crec->{informed}' WHERE id = '$crec->{id}';";
			my $rc=$self->do($sql,10);
			if($allow==1) {
				return {
					allow => 1,
					id => $crec->{id},
					notes => "Access has been granted (enough positive votes).",
					error => undef,
				};
			} else {
				return {
					allow => 0,
					id => $crec->{id},
					notes => "Access has been denied (not enough positive votes).",
					error => undef,
				};
			}
		}
	}

	return {
		allow => -1,
		id => $m->[0]->{id},
		notes => "The request has been updated as necessary.",
		error => undef,
	};
}

# If an owner of a portal or a user with portal_admin grants access to a user
# then this can be called to close off any associated request (if any) for the user/resource.
# If just a voter then the vote is register and if enough votes are possitve the 
# request to closed too.
#
# The updates performed to relevant records are:
# Decision: A - if owner/portal_admin updated...
# informed: Y utime - if enough decisions have been made or is owner/portal_admin
# owners_votes/voters_votes updated if the who_by is an owner/voter with
# any comments they provided. Can be called for owner, voter
# the owner (probably a user with portal_admin access overall).
# 
# It does not send an email - this is assumed to occur by code calling
# this separately.

sub grant_portal_access_request($$) {
my $self=shift;
my $ref=shift;

	for my $cf ('user','portal','text','frontend','who_by') {
		if(!exists($ref->{$cf})) {
			return {
				allow => -1,
				id => undef,
				error => "Missing mandatory argument '$cf'.",
				notes => undef,
			};
		}
	}
	my $user=$ref->{user};
	my $portal=$ref->{portal};
	my $txt=$ref->{text};
	my $gri_frontend=$ref->{frontend};
	my $who_by=$ref->{who_by};

	my $rr=$gri_frontend->get_portal_details($portal);
	my $portal2=encode_base64($portal,"");
	if(defined($rr->{error})) {
		return {
			allow => -1,
			id => undef,
			notes => undef,
			error => $rr->{error}
		};
	}
	my $is_owner=0;
	my $is_voter=0;
	my $is_admin=0;
	if(grep {$_ eq $who_by} @{$rr->{owners}}) {
		$is_owner=1;
	}
	if(grep {$_ eq $who_by} @{$rr->{voters}}) {
		$is_voter=1;
	}
	if($is_owner==0 && $is_voter==0) {
		my ($role,$err);
		($role,$err)=$gri_frontend->does_user_have_role($who_by,"portal_admin");
		if(!defined($role)) {
			return {
				allow => -1,
				id => undef,
				notes => undef,
				error => "Failed to get user role details for $who_by: $err",
			};
		}
		if($role==0) {
			return {
				allow => -1,
				id => undef,
				notes => undef,
				error => "The user $who_by does not have permissions to vote or grant access for the portal '$portal'.",
			};
		}
		$is_admin=1;
	}
	
	# Check to see if the request has already been raised then
	# return that ID and a message indicating the request is
	# in process.
	my $m=get_rows($self,"select * from requests where type = 'PAR' and user = '$user' and object = '$portal2' and decision = '' ORDER BY RAISED;");
	if(! @$m) {
		return {
			allow => -1,
			id => "not_found",
			error => undef,
			notes => undef,
		};
	}
	# Delete all apart from the last (previous = older duplicates)
	for(my $ii=1;$ii<scalar(@$m); $i++) {
		my $rc=$self->do("DELETE FROM requests where id = '$m->[$ii]->{id}';",10);
	}

	my $ctime=time;
	my $enc=encode_base64($txt,"").' ';
	my $crec=$m->[0];
	B1: {
		# We should have enough details to construct the record now...
		$crec->{owners_votes}='' if !defined($crec->{owners_votes});
		$crec->{voters_votes}='' if !defined($crec->{voters_votes});
		if($is_owner || $is_admin) {
			my @D=split(/\s+/,$crec->{owners_votes});
			push @D,"$who_by|$ctime|Y$enc";
			$crec->{owners_votes}=join(' ',@D);
			$crec->{decision}="A $ctime";
			$crec->{informed}="Y $ctime";
			# Write out the changed record...
			my $sql="UPDATE requests SET owners_votes='$crec->{owners_votes}', decision='$crec->{decision}', informed='$crec->{informed}' WHERE id = '$crec->{id}';";
			my $rc=$self->do($sql,10);
			return {
				allow => 1,
				id => $crec->{id},
				notes => "The request has been changed to a closed:allow status.",
				error => undef,
			};
		} else {
			# Not an owner, so register vote and comments.
			my @D=split(/\s+/,$crec->{voters_votes});
			push @D,"$who_by|$ctime|Y$enc";
			$crec->{voters_votes}=join(' ',@D);
			# Count OK votes now.
			my %u=();
			for my $dd (@D) {
				next if !$dd;
				my @f=split(/\|/,$dd);
				$u{$f[0]}=substr($f[2],0,1);
			}
			my $allow_count=0;
			my $deny_count=0;
			for my $ck (keys %u) {
				$allow_count++ if $u{$ck} eq 'Y';
				$deny_count++ if $u{$ck} eq 'N';
			}
			my $vc=scalar(@{$rr->{voters}});
			my $pass_percent=$allow_count/$vc*100.0;
			my $fail_percent=$deny_count/$vc*100.0;
			$allow=undef;
			if($crec->{concurrence} =~ /\%$/) {
				if($pass_percent >= int($crec->{concurrence})) {
					$allow=1;
				} elsif($fail_percent > (100 - int($crec->{concurrence}))) {
					$allow=0;
				}
			} else {
				if($allow_count >= $crec->{concurrence}) {
					$allow=1;
				} elsif($deny_count > ($v - $crec->{concurrence})) {
					$allow=0;
				}
			}
			# If allow==1 can allow access, allow==0 deny access, allow=undef more votes needed!!
			if(!defined($allow)) {
				my $sql="UPDATE requests SET voters_votes='$crec->{voters_votes}' WHERE id = '$crec->{id}';";
				my $rc=$self->do($sql,10);
				return {
					allow => -1,
					id => $crec->{id},
					notes => "Your vote has been registered for request.",
					error => undef,
				};
			} elsif($allow==1) {
				$crec->{decision}="A $ctime";
				$crec->{informed}="Y $ctime";
			} elsif($allow==0) {
				$crec->{decision}="D $ctime";
				$crec->{informed}="Y $ctime";
			}
			my $sql="UPDATE requests SET voters_votes='$crec->{voters_votes}', decision='$crec->{decision}', informed='$crec->{informed}' WHERE id = '$crec->{id}';";
			my $rc=$self->do($sql,10);
			if($allow==1) {
				return {
					allow => 1,
					id => $crec->{id},
					notes => "Access has been granted (enough positive votes).",
					error => undef,
				};
			} else {
				return {
					allow => 0,
					id => $crec->{id},
					notes => "Access has been denied (not enough positive votes).",
					error => undef,
				};
			}
		}
	}
	return {
		allow => -1,
		id => $m->[0]->{id},
		notes => "The request has been updated as necessary.",
		error => undef,
	};
}

# Add a comment (no vote)

sub comment_portal_access_request($$) {
my $self=shift;
my $ref=shift;

	for my $cf ('id','text','portal','frontend','who_by') {
		if(!exists($ref->{$cf})) {
			return {
				allow => -1,
				id => undef,
				error => "Missing mandatory argument '$cf'.",
				notes => undef,
			};
		}
	}

	my $portal=$ref->{portal};
	my $gri_frontend=$ref->{frontend};
	my $who_by=$ref->{who_by};
	my $id=$ref->{id};
	my $txt=$ref->{text};

	my $rr=$gri_frontend->get_portal_details($portal);
	if(defined($rr->{error})) {
		return {
			allow => -1,
			id => undef,
			notes => undef,
			error => $rr->{error}
		};
	}

	# Work out user's role for this particular portal
	my $is_owner=0;
	my $is_voter=0;
	my $is_admin=0;
	if(grep {$_ eq $who_by} @{$rr->{owners}}) {
		$is_owner=1;
	}
	if(grep {$_ eq $who_by} @{$rr->{voters}}) {
		$is_voter=1;
	}
	if($is_owner==0 && $is_voter==0) {
		my ($role,$err);
		($role,$err)=$gri_frontend->does_user_have_role($who_by,"portal_admin");
		if(!defined($role)) {
			return {
				allow => -1,
				id => $id,
				notes => undef,
				error => "Failed to get user role details for $who_by: $err",
			};
		}
		if($role==0) {
			return {
				allow => -1,
				id => $id,
				notes => undef,
				error => "The user $who_by does not have permissions to vote or grant access for the portal '$portal'.",
			};
		}
		$is_admin=1;
	}

	# Check to see if the request has already been raised then
	# return that ID and a message indicating the request is
	# in process.
	my $m=get_rows($self,"select * from requests where id = '$id';");
	if(! @$m) {
		return {
			allow => -1,
			id => "not_found",
			error => undef,
			notes => undef,
		};
	}
	# Add a comment to the owners (if owner or admin, or voters otherwise)

	my $ctime=time;
	my $enc=encode_base64($txt,"").' ';
	my $crec=$m->[0];
	my $ss="$who_by|$ctime|C$enc";
	# We should have enough details to construct the record now...
	$crec->{owners_votes}='' if !defined($crec->{owners_votes});
	$crec->{voters_votes}='' if !defined($crec->{voters_votes});
	if($is_owner || $is_admin) {
		if(!length($crec->{owners_votes})) {
			$crec->{owners_votes}=$ss;
		} else {
			$crec->{owners_votes}.=" $ss";
		}
	} else {
		if(!length($crec->{voters_votes})) {
			$crec->{voters_votes}=$ss;
		} else {
			$crec->{voters_votes}.=" $ss";
		}
	}
	# Write out the changed record...
	my $sql="UPDATE requests SET owners_votes='$crec->{owners_votes}', voters_votes='$crec->{voters_votes}' WHERE id = '$id';";
	my $rc=$self->do($sql,10);
	return {
		allow => -1,
		id => $id,
		notes => "The request has been changed as requested.",
		error => undef,
	};
}

# Take an ID and cancel it (does not remove it from database, but sets
# the decision to "CA nnn" (user cancelled at time).

sub user_cancel_request($$) {
my $self=shift;
my $r=shift;

	my $id=$r->{id};
	if($id !~ /^\d+$/) {
		return {
			id => undef,
			error => "Invalid ID specified [$id].",
			notes => undef,
		};
	}
	my $user=$r->{user};

	my $m=get_rows($self,"select * from requests where id = '$id' AND user = '$user';");
	if(! @$m) {
		return {
			id => "not_found",
			error => "Specified request information was not found.",
			notes => undef,
		};
	}

	# If the request is already complete then of course it cannot be cancelled

	if(defined($m->[0]->{decision}) && length($m->[0]->{decision})) {
		return {
			id => $id,
			error => "Specified request is already complete or cancelled and so cannot be cancelled.",
			notes => undef,
		};
	}
	my $d="CA " . time();
	my $sql="UPDATE requests SET decision='$d' WHERE id = '$id';";
	my $rc=$self->do($sql,10);
	if(!$rc) {
		return {
			id => $id,
			error => "Failed to update record in request database.",
			notes => undef,
		};
	}
	return {
		id => $id,
		error => undef,
		notes => "Request $id marked as cancelled by user.",
	};
}

# Scan all open requests and if one has user as a voter or owner and
# not decided as yet, then add to a list of id's to return.

sub my_outstanding_approvals($$) {
my $self=shift;
my $id=shift;
my @R=();

	my $sql="SELECT * FROM requests WHERE decision='';";
	my $rr=get_rows($self,$sql);
	if(!defined($rr)) {
		return {error => "Failed to run query: $sql", records => []};
	}
	for my $r (@$rr) {
		my @X=split(/\s+/,$r->{owners_votes});
		my @X2=split(/\s+/,$r->{voters_votes});
		my $is_voter=0;
		my $voted=0;
		for my $cv (@X,@X2) {
			my @v=split(/\|/,$cv);
			next if !@v || $v[0] ne $id;
			$is_voter=1;
			if(@v>1 && $v[1] && substr($v[2],0,1) ne 'C') {
				$voted=1; last;
			}
		}
		if($is_voter && !$voted) {
			push @R,$r;
		}
	}
	return {records => [@R], error => undef};
}


sub decode($$) {
my $self=shift;
my $r=shift;

	my $n={};
	my $updated=0;
	if(defined($r->{informed}) && length($r->{informed})) {
		$updated=$r->{informed}; $updated =~ s/^Y\s+//;
	} else {
		my @X=split(/\s+/,$r->{owners_votes});
		my @X2=split(/\s+/,$r->{voters_votes});
		for my $rrr (@X,@X2) {
			my @d=split(/\|/,$rrr);
			if(defined($d[1]) && length($d[1]) && $d[1] > $updated) {
				$updated=$d[1];
			}
		}
	}
	$n->{update}=$updated;
	$n->{id}=$r->{id};
	$n->{object}=decode_base64($r->{object});
	$n->{raised}=$r->{raised};
	$n->{decision_time}=undef;
	if(substr($r->{decision},0,1) eq 'A') {
		$n->{decision}='Granted';
		my @D=split(/\s+/,$r->{decision});
		if(@D>1) {
			$n->{decision_time}=$D[1];
		} else {
			@D=split(/\s+/,$r->{informed});
			if(@D>1) {
				$n->{decision_time}=$D[1];
			}
		}
		if(!defined($n->{decision_time})) {
			$n->{decision_time}=$updated;
		}
	} elsif(substr($r->{decision},0,2) eq 'CA') {
		$n->{decision}='User Cancelled';
		my @D=split(/\s+/,$r->{decision});
		$n->{decision_time}=$D[1];
		if(!defined($n->{decision_time})) {
			$n->{decision_time}=$updated;
		}
	} elsif(substr($r->{decision},0,1) eq 'D') {
		$n->{decision}='Denied';
		my @D=split(/\s+/,$r->{decision});
		$n->{decision_time}=$D[1];
		if(!defined($n->{decision_time})) {
			$n->{decision_time}=$updated;
		}
	} else {
		$n->{decision}='In Progress';
		$n->{decision_time}=0;
	}
	$n->{user}=$r->{user};
	$n->{voters}=[];
	$n->{owners}=[];
	if(defined($r->{owners_votes})) {
		my @D=split(/\s+/,$r->{owners_votes});
		for my $cd (@D) {
			my ($a,$b,$c)=split(/\|/,$cd);
			my $vote='';
			my $txt='';
			if(defined($c) && length($b)) {
				$vote=substr($c,0,1);
				$txt=decode_base64(substr($c,1));
			} elsif(defined($c)) {
				$txt=decode_base64($c);
			}
			push @{$n->{owners}},{who=>$a,when=>$b,vote=>$vote,text=>$txt};
		}
	}
	if(defined($r->{voters_votes}) && $r->{voters_votes} ne 'N/A') {
		my @D=split(/\s+/,$r->{voters_votes});
		for my $cd (@D) {
			my ($a,$b,$c)=split(/\|/,$cd);
			my $vote='';
			my $txt='';
			if(defined($c) && length($b)) {
				$vote=substr($c,0,1);
				$txt=decode_base64(substr($c,1));
			} elsif(defined($c)) {
				$txt=decode_base64($c);
			}
			push @{$n->{voters}},{who=>$a,when=>$b,vote=>$vote,text=>$txt};
		}
	}
	return $n;
}

sub get_request($$) {
my $self=shift;
my $id=shift;

	my $sql="SELECT * FROM requests WHERE id = '$id';";
	my $m=get_rows($self,$sql);
	if(!defined($m) || scalar(@$m)==0) {
		return(undef);
	}
	return $m->[0];
}

sub get_all_requests($$) {
my $self=shift;
my $type=shift;

	my $sql="SELECT * FROM requests;";
	if($type) {
		$sql="SELECT * FROM requests WHERE type = '$type';";
	}

	my $m=get_rows($self,$sql);
	if(!defined($m) || scalar(@$m)==0) {
		return([]);
	}
	return $m;
}

1;

# vim: ts=4:sw=4
